perm filename EPAR3E.2[EAL,HE]1 blob
sn#679407 filedate 1982-09-27 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00005 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 {$NOMAIN Editor: Aux parsing routines }
C00005 00003 (* aux function for motion clauses: eClauseParse *)
C00018 00004 (* eCmonParse *)
C00026 00005 (* eMClauseParse *)
C00032 ENDMK
C⊗;
{$NOMAIN Editor: Aux parsing routines }
%include eparse.hdr;
{ Externally defined routines from elsewhere: }
(* From ALLOC *)
function newNode: nodep; external;
procedure relNode(n: nodep); external;
procedure relToken(n: tokenp); external;
procedure relStrng(n: strngp); external;
(* From EROOT: Inter-overlay calls *)
function e3eExprParse: nodep; external;
(* From PAUX1 *)
function getDtype(n: nodep): datatypes; external;
function checkArg(n: nodep; d: datatypes): nodep; external;
(* From PAUX2 *)
function evalOrder(what,last: nodep; pcons: boolean): nodep; external;
procedure relExpr(n: nodep); external;
(* From EAUX1A *)
function eMakeVar(vartype: datatypes; vid: identp): varidefp; external;
(* From ETOKEN *)
procedure eGetToken; external;
procedure eDimCheck(n,d: nodep); external;
function eCopyToken: tokenp; external;
procedure eGetDelim(char: ascii); external;
(* From EMOVEO *)
procedure moveOrder(st: statementp); external;
(* From PP *)
procedure ppLine; external;
procedure ppOutNow; external;
procedure ppChar(ch: ascii); external;
procedure pp5(ch: c5str; length: integer); external;
procedure pp10(ch: cstring; length: integer); external;
procedure pp10L(ch: cstring; length: integer); external;
procedure pp20(ch: c20str; length: integer); external;
procedure pp20L(ch: c20str; length: integer); external;
procedure ppInt(i: integer); external;
procedure ppReal(r: real); external;
procedure ppStrng(length: integer; s: strngp); external;
procedure ppDtype(d: datatypes); external;
procedure ppDelChar; external;
procedure ePar3eGet; external;
procedure ePar3eGet; begin end;
(* aux function for motion clauses: eClauseParse *)
function eClauseParse(n: nodep; absSeen: boolean): nodep; external;
function eClauseParse;
var cl,nv,vdim: nodep; b,bp: boolean; dummyrel: reltypes; bits,i: integer;
d: datatypes;
function relParse: reltypes;
begin
eGetToken; (* get the relation *)
with eCurToken do
if (ttype = reswdtype) and (rtype = optype) and (op <= sgtop) then
relParse := op
else
begin
pp20L(' Need a relational o',20); pp20('perator here ',12); ppLine;
eBackup := true;
relParse := seqop;
end;
end;
begin
eGetToken;
if n = nil then cl := newNode else cl := n;
with eCurToken do
begin
if (ttype = identtype) then b := id↑.name↑.ch = 'SPEED_FACT' else b := false;
if b then
begin
with cl↑ do
begin
ntype := sfacnode;
dummyrel := relParse; (* skip over the "=" *)
clval := checkArg(e3eExprParse,svaltype);
eDimCheck(clval,nodim↑.dim);
end;
end
else if (ttype <> reswdtype) or (rtype <> clsetype) then
begin
if n = nil then begin relNode(cl); cl := nil; end;
eBackup := true;
pp20L(' Not a valid clause ',19); ppLine;
end
else
begin
with cl↑ do
case clause of
durationtype:
begin
ntype := durnode;
durrel := relParse;
durval := checkArg(e3eExprParse,svaltype);
eDimCheck(durval,timedim↑.dim);
end;
wobbletype,
stopwaittimetype:
begin
if clause = wobbletype then
begin
ntype := wobblenode;
vdim := angledim↑.dim;
end
else
begin
ntype := swtnode;
vdim := timedim↑.dim;
end;
dummyrel := relParse;
clval := checkArg(e3eExprParse,svaltype);
eDimCheck(clval,vdim);
end;
nullingtype,
nonullingtype:
begin
ntype := nullingnode;
if clause = nonullingtype then notp := true else notp := false;
end;
cwtype,
ccwtype:
begin
ntype := cwnode;
if clause = cwtype then notp := false else notp := true;
end;
approachtype,
departuretype:
begin
if clause = approachtype then ntype := apprnode else ntype := deprnode;
dummyrel := relParse;
eGetToken; (* check for NILDEPROACH *)
if (ttype = reswdtype) and
(rtype = clsetype) and (clause = nildeproachtype) then loc := nil
else
begin (* need to get deproach value *)
eBackup := true;
loc := e3eExprParse; (* can be scalar, vector or trans *)
eDimCheck(loc,distancedim↑.dim);
end;
code := nil;
(* *** what about THEN ??? *** *)
end;
forcewristtype:
begin
ntype := wristnode;
eGetToken;
if (ttype = reswdtype) and (rtype = optype) and
(eCurToken.op = notop) then
begin
notp := true;
eGetToken;
end
else notp := false;
if (ttype <> reswdtype) or (rtype <> filtype) or
(filler <> zeroedtype) then
begin
eBackup := true;
pp20L(' Garbage clause ',15); ppLine;
end
end;
forceframetype:
begin
ntype := ffnode;
if not absSeen then dummyrel := relParse;
ff := checkArg(e3eExprParse,transtype);
eDimCheck(ff,distancedim↑.dim);
csys := true; (* assume WORLD if not specified *)
eGetToken;
if (ttype = reswdtype) and (rtype = filtype) and (filler = intype) then
begin (* see whether WORLD or HAND coord sys *)
eGetToken;
if (ttype = reswdtype) and (rtype = filtype) and
(filler = handtype) then csys := false (* use HAND coords *)
else if (ttype <> reswdtype) or (rtype <> filtype) or
(filler <> worldtype) then (* better be WORLD coords *)
begin
eBackup := true;
pp20L(' Need HAND or WORLD ',20); pp5('here ',4); ppLine;
end
end
else eBackup := true;
end;
forcetype,
torquetype,
angularvelocitytype:
begin
ntype := forcenode;
if clause = forcetype then
begin ftype := force; vdim := forcedim↑.dim end
else if clause = torquetype then
begin ftype := torque; vdim := torquedim↑.dim end
else begin ftype := angvelocity; vdim := angveldim↑.dim end;
if absSeen then ftype := succ(ftype);
eGetToken;
if (ttype = delimtype) and (ch = '(') then (* short form *)
begin
b := true;
fvec := checkArg(e3eExprParse,vectype);
eGetDelim(')'); (* get closing ")" *)
eGetToken;
end
else b := false; (* long form *)
if absSeen then
begin
if (ttype <> reswdtype) or (rtype <> optype) or
(eCurToken.op <> absop) then
begin
eBackup := true;
pp20L(' Need closing "|" he',20); pp5('re ',2); ppLine;
end;
end
else eBackup := true;
frel := relparse;
fval := checkArg(e3eExprParse,svaltype);
eDimCheck(fval,vdim);
i := cursor;
bp := true;
while (i > 2) and bp do
with cursorStack[i] do
if stmntp and (movetype <= st↑.stype) and (st↑.stype <= centertype)
then bp := false else i := i - 1;
with cursorStack[i].st↑ do
if (stype = opentype) or (stype = closetype) or (stype = operatetype) then
begin
b := true; (* so we don't look for a vector specification *)
cl↑.fvec := nil;
end;
if not b then
begin
eGetToken;
if (ttype <> reswdtype) or (rtype <> filtype) or
((filler <> abouttype) and (filler <> alongtype)) then
begin
eBackup := true;
pp20L(' Need ALONG or ABOUT',20); pp5(' here',5);
end;
fvec := checkArg(e3eExprParse,vectype);
end;
eGetToken; (* check for force frame *)
eBackup := true;
if (ttype = reswdtype) and (rtype = filtype) and (filler = oftype) then
begin
rtype := clsetype; (* make eCurToken look like forceframe clause *)
clause := forceframetype;
fframe := eClauseParse(nil,true);
end
else fframe := nil;
end;
stiffnesstype:
begin
ntype := stiffnode;
dummyrel := relParse; (* skip over the "=" *)
eGetDelim('('); (* now look for the "(" *)
fv := e3eExprParse; (* get the first stiffness component *)
if getDtype(fv) = svaltype then (* see if it's 6 scalars or 2 vectors *)
for i := 1 to 2 do
begin
nv := newNode;
with nv↑ do
begin
ntype := exprnode;
op := vmakeop;
if i = 2 then arg1 := checkArg(e3eExprParse,svaltype)
else arg1 := cl↑.fv;
eGetDelim(',');
arg2 := checkArg(e3eExprParse,svaltype);
eGetDelim(',');
arg3 := checkArg(e3eExprParse,svaltype);
end;
if i = 1 then begin fv := nv; eGetDelim(',') end else mv := nv;
end
else
begin (* two vectors *)
fv := checkArg(fv,vectype);
eGetDelim(','); (* now look for the separating "," *)
mv := checkArg(e3eExprParse,vectype);
end;
eDimCheck(fv,fvstiffdim);
eDimCheck(mv,mvstiffdim);
eGetDelim(')'); (* now look for the ")" *)
eGetToken; (* is a center of compliance given? *)
if (ttype = reswdtype) and (rtype = filtype) and (filler = abouttype) then
coc := checkArg(e3eExprParse,transtype)
else begin coc := nil; eBackup := true; end;
end;
gathertype:
begin
ntype := gathernode;
dummyrel := relParse; (* skip over the "=" *)
eGetDelim('('); (* now look for the "(" *)
b := false;
gbits := 0;
repeat
bits := 0;
eGetToken; (* get component to gather *)
if (ttype <> reswdtype) or (rtype <> clsetype) then b := true
else
case clause of
fxtype: bits := 1B;
fytype: bits := 2B;
fztype: bits := 4B;
mxtype: bits := 10B;
mytype: bits := 20B;
mztype: bits := 40B;
t1type: bits := 100B;
t2type: bits := 200B;
t3type: bits := 400B;
t4type: bits := 1000B;
t5type: bits := 2000B;
t6type: bits := 4000B;
tbltype: bits := 10000B;
otherwise {do nothing};
end;
if bits = 0 then b := true; (* bad clause *)
gbits := gbits + bits; (* really need to logically OR these *)
if b then
begin
pp20L(' Expecting a force c',20); pp20('omponent here ',13);
ppLine;
end
else eGetToken; (* pick up the "," or ")" *)
until (ttype <> delimtype) or (ch <> ',') or b;
eBackup := true;
eGetDelim(')'); (* now look for the ")" *)
end;
otherwise {do nothing};
end;
end;
end;
eClauseParse := cl;
end;
(* eCmonParse *)
procedure eCmonParse(st: statementp; getStart: boolean); external;
procedure eCmonParse;
var inMove: boolean; i: integer; t: tokenp;
begin
with cursorStack[cursor-1] do
inMove := (not stmntp) and (nd↑.ntype = cmonnode);
with st↑, eCurToken do
begin
if oncond <> nil then
with oncond↑ do (* see what sort of cmon we were & release any old fields *)
if ntype = durnode then begin relExpr(durval); relNode(oncond) end
else if ntype = forcenode then
begin relExpr(fval); relExpr(fvec); relExpr(fframe); relNode(oncond) end
else if ntype = errornode then
begin
relExpr(eexpr); relNode(oncond);
if inMove then cursorStack[cursor-1].nd↑.errhandlerp := false;
end
else relExpr(oncond);
exprCm := false;
oncond := nil;
exprs := nil;
eGetToken; (* see what sort of cmon we are now *)
if getStart then
begin
deferCm := false;
if (ttype = reswdtype) and (rtype = filtype) and (filler = defertype) then
begin
deferCm := true;
eGetToken;
end;
if (ttype <> reswdtype) or (rtype <> stmnttype) or (stmnt <> cmtype) then
begin
pp20L(' Expecting an "ON" h',20); pp5('ere ',3); ppLine;
end
else eGetToken;
end;
if (ttype = reswdtype) and (rtype = clsetype) then
begin
if (clause = durationtype) or (clause = forcetype) or (clause = torquetype) then
begin
eBackup := true;
oncond := eClauseParse(nil,false);
end
else if (clause = arrivaltype) or (clause = departingtype) then
begin
if inMove then
begin
st↑.oncond := newNode;
with st↑.oncond↑ do
if clause = arrivaltype then
begin
ntype := arrivalnode;
evar := eMakeVar(eventtype,nil);
end
else
ntype := departingnode;
end
else
begin
pp20L('Must be part of MOVE',20); pp10(' statement',10); ppLine;
end;
end
else if clause = errortype then
begin
oncond := newNode;
with oncond↑ do
begin
ntype := errornode;
eGetToken; (* skip over the "=" *)
eexpr := e3eExprParse; (* get desired error bits *)
eDimCheck(eexpr,nodim↑.dim);
end;
if not inMove then
begin (* no good *)
pp20L('Must be part of MOVE',20); pp10(' statement',10); ppLine;
end
else
begin (* point back to motion statement, not cmon *)
cursorStack[cursor-1].nd↑.errhandlerp := true;
st↑.conclusion↑.next↑.bparent := cursorStack[cursor-2].st;
end;
end
else
begin pp20L('Unknown ON condition',20); ppLine end
end
else if (ttype = reswdtype) and (rtype = optype) and (op = absop) then
begin (* is it |Force...| or |Torque...|? *)
eGetToken; (* see what next token is *)
eBackup := true;
if (ttype = reswdtype) and (rtype = clsetype) and
((clause = forcetype) or (clause = torquetype)) then
oncond := eClauseParse(nil,true) (* yes - |Force/Torque...| cmon *)
else
begin (* no - expression cmon *)
exprCm := true;
t := eCopyToken; (* make a copy of token we just peeked at *)
next := t; (* fix things up so the peeked at token is next *)
ttype := reswdtype; (* and the "|" gets seen again by exprParse *)
rtype := optype;
op := absop;
if macrodepth = 0 then (* pretend we're a macro *)
begin
macrodepth := 1;
curmacstack[macrodepth] := nil;
macrostack[macrodepth] := nil;
end;
oncond := e3eExprParse; (* get expression for cmon *)
relToken(t); (* done with peeked at token now *)
end
end
else
begin
eBackup := true;
oncond := e3eExprParse; (* get the cmon condition *)
if getDtype(oncond) <> eventtype then exprCm := true;
end;
if oncond <> nil then
with oncond↑ do
if (ntype = forcenode) and not inMove then
begin
pp20L('Force sensing must b',20); pp20('e part of a MOVE sta',20);
pp10('tement ',6); ppLine;
relExpr(oncond);
oncond := nil;
end
else if exprCm or (ntype = durnode) or (ntype = forcenode) then
exprs := evalOrder(oncond,nil,true)
else if ntype = exprnode then (* subscripted event *)
exprs := evalOrder(arg2,nil,true)
else exprs := nil;
end;
if inMove then moveOrder(cursorStack[cursor-2].st);
end;
(* eMClauseParse *)
procedure eMClauseParse(n: nodep); external;
procedure eMClauseParse;
var np,no: nodep; strp: strngp; b: boolean; oldVcode: statementp;
begin (* dest, via, with *)
with n↑ do
if ntype = destnode then
begin
relExpr(loc);
if cursorStack[cursor-1].st↑.stype = movetype then
loc := checkArg(e3eExprParse,transtype)
else loc := checkArg(e3eExprParse,svaltype);
eDimCheck(loc,distancedim↑.dim);
end
else if ntype = viaptnode then
begin (* ** maybe should check that this is a MOVE stmnt ?? ** *)
np := n;
oldVcode := nil;
while np <> nil do (* first free up old values *)
begin
with np↑ do
begin
relExpr(via);
relExpr(duration);
relExpr(velocity);
if vcode <> nil then oldVcode := vcode; (* need to remember old code *)
np := next;
end;
if np <> nil then
if (np↑.ntype <> viaptnode) or (not np↑.vlist) then np := nil;
end;
with eCurToken do
repeat
with n↑ do
begin
via := checkArg(e3eExprParse,transtype);
eDimCheck(via,distancedim↑.dim);
velocity := nil;
duration := nil;
vcode := nil;
eGetToken;
if (ttype = reswdtype) and
(rtype = filtype) and (filler = wheretype) then
begin
b := true;
while b do
begin (* look for velocity & duration specs *)
eGetToken;
if (ttype = reswdtype) and
(rtype = clsetype) and (clause = velocitytype) then
begin
eGetToken; (* skip over the '=' *)
velocity := checkArg(e3eExprParse,vectype);
eDimCheck(velocity,veldim↑.dim);
end
else if (ttype = reswdtype) and
(rtype = clsetype) and (clause = durationtype) then
begin
eBackup := true;
duration := eClauseParse(nil,false); (* go get the duration spec *)
end
else if (ttype <> delimtype) or (ch <> ',') then
begin eBackup := true; b := false; end;
end;
end;
end;
if (ttype = delimtype) and (ch = ',') then
begin (* need to add a new via point *)
if n↑.next = nil then b := true
else b := (n↑.next↑.ntype <> viaptnode) or (not n↑.next↑.vlist);
if b then
begin (* make up a new node *)
np := newNode;
with np↑ do
begin
ntype := viaptnode;
next := n↑.next;
vlist := true;
end;
n↑.next := np;
n := np;
end
else n := n↑.next; (* just re-use next via list node *)
b := false;
end
else b := true;
until b;
n↑.vcode := oldVcode; (* keep tabs on associated code *)
np := n↑.next;
while np <> nil do (* flush any extra via list nodes *)
with np↑ do
if (ntype = viaptnode) and vlist then
begin no := np; np := next; relNode(no); n↑.next := np end
else np := nil;
end
else if ntype = commentnode then
begin
while str <> nil do (* release old comment string *)
begin strp := str↑.next; relStrng(str); str := strp end;
curChar := 1;
maxChar := maxChar + 9;
flushComments := false;
eGetToken; (* get the comment *)
flushComments := true;
length := eCurToken.len; (* don't even need to check it?!? *)
str := eCurToken.str;
end
else
begin (* a WITH clause *)
case ntype of (* release old expressions *)
deprnode,
apprnode: relExpr(loc);
durnode: relExpr(durval);
sfacnode,
wobblenode,
swtnode: relExpr(clval);
ffnode: relExpr(ff);
forcenode: begin relExpr(fval); relExpr(fvec); relExpr(fframe); end;
stiffnode: begin relExpr(fv); relExpr(mv); relExpr(coc); end;
otherwise {do nothing};
end;
np := eClauseParse(n,false);
end;
moveOrder(cursorStack[cursor-1].st);
end;